#!/usr/bin/perl
# Copyright (C) 2005 Christopher Faylor
#
# This software is a copyrighted work licensed under the terms of the
# GNU General Public License.  See http://www.gnu.org/copyleft/gpl.html
# for details.
#
use File::Basename;
use Digest::MD5;
use Getopt::Long;

sub mywarn(@);
sub myerror(@);
sub usage();

my @okmissing;
my ($outfile, $help);
GetOptions('okmissing=s'=>\@okmissing, 'output=s'=>\$outfile, 'help'=>\$help) or usage;
$help and usage;

@main::okmissing{@okmissing} = @okmissing;

if (defined($outfile)) {
    open(STDOUT, '>', $outfile) or die "$0: can't open $outfile - $!\n";
}

local %pkg;

for my $f (@ARGV) {
    if (-d $f) {
	parsedir($f);
    } else {
	parse($f);
    }
}

print <<'EOF';
# This file is automatically generated.  If you edit it, your
# edits will be discarded next time the file is generated.
# See http://cygwin.com/setup.html for details.
#
EOF

print "$main::setup_timestamp\n" if $main::setup_timestamp;
print "$main::setup_version\n" if $main::setup_version;

undef $main::curfile;
for my $p (sort keys %pkg) {
    print "\n@ $p\n";
    for my $key ('sdesc', 'ldesc', 'category', 'requires') {
	my $val = $pkg{$p}{''}{$key};
	if (!defined($val)) {
	    mywarn "package $p is missing a $key field"
	      unless defined $main::okmissing{$key};
	} else {
	    if ($key eq 'requires') {
		for my $p1 (split(' ', $val)) {
		    mywarn "package $p requires on unknown package '$p1'"
		      unless $pkg{$p};
		}
	    } elsif ($key eq 'category') {
		for my $c (split(' ', $val)) {
		    mywarn "package $p uses an invalid category '$c'"
		      unless $main::categories{lc $c};
		}
	    }
	    print "$key: ", $val, "\n";
	}
    }
    for my $what ('', "[prev]\n", "[test]\n") {
	$pkg{$p}{$what} or next;
	print "$what";
	for my $key ('version', 'install', 'source') {
	    my $val = $pkg{$p}{$what}{$key} or next;
	    print "$key: ", $val, "\n";
	}
    }
}

sub get {
    my $FH = shift;
    my $key = shift;
    my $val = shift;

    if (substr($val, 0, 1) eq '"') {
	while (length($val) == 1 || $val !~ /"$/os) {
	    $_ = <$FH>;
	    length or last;
	    chomp;
	    s/(\S)\s+$//;
	    $val .= "\n" . $_;
	}
    } 
    return $val;
}

sub parse {
    my $f = shift;
    my $pname = shift;
    my $what;
    $main::curfile = $f;
    $. = 0;
    open(F, '<', $f) or die "$0: couldn't open $f - $!\n";
    while (<F>) {
	chomp;
	s/#.*$//o;
	s/^\s+//o;
	s/(\S)\s+$/$1/o;
	length or next;
	/^setup-timestamp:/ and do {
	    $main::setup_timestamp = $_;
	    next;
	};
	/^setup-version:/ and do {
	    $main::setup_version = $_;
	    next;
	};
	/^\@\s+(\S+)/ and do {
	    $pname = $1;
	    $what = '';
	    next;
	};
	/^([^:]+):\s+(.*)$/ and do {
	    my $key = $1;
	    my $val = $2;
	    if ($key !~ /^(?:prev|curr|test)/) {
		$pkg{$pname}{$what}{$key} = get(F, $key, $val);
	    } else {
		if ($key eq 'curr') {
		    $key = '';
		} else {
		    $key = "[$key]\n";
		}
		$pkg{$pname}{$key}{'version'} = $val;
	    }
	    next;
	};
	/^\[[^\]]+\]/ and do {
	    $what = $_ . "\n";
	    next;
	};
	die "$0: unrecognized input at line file $ARGV[0], line $.\n";
    }
}

sub parsedir {
    my $d = shift;
    my $pname = basename($d);
    delete $pkg{$pname};
    parse("$d/setup.hint", $pname);
    my $explicit = 0;
    for my $what ('', "[prev]\n", "[test]\n") {
	my $x = $pkg{$pname}{$what};
	next unless $x->{'version'};
	$explicit = 1;
	addfiles($pname, $x, $d);
    }

    return if $explicit;
    my @files = sort grep{!/-src\.tar.bz2/} glob("$d/*.tar.bz2");
    if (!@files) {
	myerror "not enough package files in $d";
	return;
    }
    for my $what ('', "[prev]\n") {
	my $f = pop @files or last;
	$pkg{$pname}{$what}{-unused} = 1;
	my $x = $pkg{$pname}{$what};
	my $p;
	($p, $x->{'version'}) = getver($f);
	addfiles($p, $x, $d);
    }
}

sub addfiles {
    my $pname = shift;
    my $x = shift;
    my $d = shift;

    my $install = "$d/" . tarball($pname, $x->{'version'});
    filer($x, 'install', $install);

    if ($pkg{$pname}{''}{'external-source'}) {
	$pname = $pkg{$pname}{''}{'external-source'};
	$d = finddir($d, $pname) or return;
    }

    my $source  = "$d/" . tarball($pname, $x->{'version'}, 'src');
    filer($x, 'source', $source);
}

sub getver {
    my $f = basename($_[0]);
    my @a = ($f =~ /^(.*?)-(\d.*)\.tar/);
    return wantarray ? @a : $a[1];
}

sub filer {
    my $x = shift;
    my $what = shift;
    my $f = shift;
    open(*F, '<', $f) or do {
	myerror "can't open $f - $!" unless $main::okmissing{$what};
	return undef;
    };
    my $md5 = Digest::MD5->new;
    $md5->addfile(\*F);
    $x->{$what} = join(' ', $f, -s $f, $md5->hexdigest);
}

sub tarball {
    return join('-', @_) . '.tar.bz2';
}

sub fnln {
    return $main::curfile ? "$main::curfile:$.: " : '';
}

sub mywarn(@) {
    warn "warning: " . fnln . "@_\n";
}

sub myerror(@) {
    warn "error: " . fnln . "@_\n";
}

sub finddir {
    my $d = $_[0];
    my $pname = $_[1];
    while (($d = dirname($d)) ne '.' && length($d)) {
	return "$d/$pname" if -d "$d/$pname";
    }
    myerror "couldn't find package direcory for external-source '$pname'";
    return undef;
}

sub usage() {
    print STDERR <<'EOF';
Usage: genini [--okmissing=key ...] [--output=file] [--help] setup.ini [dir ...]
Create cygwin setup.ini from setup.ini, setup.hint and tar ball information.

    --okmissing=key    don't warn if key is missing from setup.ini or setup.hint
    --output=file      output setup.ini info to file
    --help             display this message

Report bugs to cygwin mailing list.
EOF
    exit 0;
}

BEGIN {
    my @cats = qw'
     Admin Archive Audio Base Comm Database Devel Doc Editors Games
     Gnome Graphics Interpreters Libs Mail Math Mingw Net Perl Publishing
     Science Shells Sound System Text Utils Web X11
     _obsolete _PostInstallLast
     ';
    @main::categories{map {lc $_} @cats} = @cats;
}
